Protocol 4 - Provenance data with shipwrecks

The following example applies protocol 4 to confirm shipwrecks samples attribution to workshops’ provenance groups.

Protocol 4 consist in:

  1. Select provenance-specific variables in geochemical compositional data (CoDa) and ordinal petrographic data;
  2. Centred log-ratio transformation (clr) and transform to ranks;
  3. Extended Gower coefficient of dissimilarity, using Relative ranking difference (RRD);
  4. Apply Principal Coordinates Analysis (PCoA);
  5. Perform PERMANOVA & PERMDISP tests;

Last, search for outliers and re-do protocol excluding outliers.

NOTE: The initial procedures must be ran at least once before any protocol can be applied.

Ordination procedure

As protocol 3, protocol 4 performs PCoA on a distance matrix calculated with Extended Gower coefficient of dissimilarity, combining Euclidean distances on transformed compositional data (50%) and RRD on ranked petrographic data (50%). In this case, we are not filtering out the shipwreck samples, but we do exclude the true outliers (IND, observations with no group assigned) so they don’t pollute visualization.

prot4_Shipwreck_2d <- apply_ordination(# no true outliers
                                       cleanAmphorae[!isTrueIND,],
                                       "4", # select protocol 4
                                       exception_columns = excep_cols,
                                       variable_tags = varCode,
                                       coda_override = chemVars16,
                                       coda_transformation = "CLR")

prot4_Shipwreck_3d <- apply_ordination(# no true outliers
                                       cleanAmphorae[!isTrueIND,],
                                       "4", # select protocol 4
                                       exception_columns = excep_cols,
                                       variable_tags = varCode,
                                       coda_override = chemVars16,
                                       coda_transformation = "CLR",
                                       dimensions = 3)

Simplify CoDa names

We may want to simplify the names of the transformed variables before plotting them in a biplot.

prot4_Shipwreck_2d <- simplify_coda_names(prot4_Shipwreck_2d)
prot4_Shipwreck_3d <- simplify_coda_names(prot4_Shipwreck_3d)

Test the given provenance groups

We can test the provenance assigned to shipwrecks’ amphorae samples together with those found and assigned to the workshops.

prot4_Shipwreck_tests <- test_groups(prot4_Shipwreck_2d$dist_matrix,
                                     factor_list_Shipwreck$ProvGroup)
#> [1] "initiating test batch..."
#> [1] "vegan::anosim done."
#> [1] "vegan::betadisper done."
#> [1] "vegan::permutest done."
#> [1] "vegan::adonis done."
#> [1] "Test batch completed."

These tests were explained in protocol 1.

Biplots

The details on how to create biplots is already explained in protocol 1. Protocol 4 generates PCoA projections.

Biplot 2D

arrows_label_adj <- rbind(c(.5,0),c(.5,1),c(.5,0),c(.5,1),c(.5,0),
                          c(.5,1),c(.8,0),c(1,.5),c(.5,0),c(1,.2),
                          c(.5,1),c(.2,.7))
row.names(arrows_label_adj) <- c("S7","S8","S4","CaO","MgO",
                                 "S11","L48","SiO2","Ce","Nb",
                                 "Th","TiO2")

biplot2d3d::biplot_2d(prot4_Shipwreck_2d,
                       ordination_method = "PCoA",
                       invert_coordinates = c (TRUE,TRUE),
                       ylim = c(-.3,.25),
                       point_type = "point",
                       groups = factor_list_Shipwreck$ProvGroup,
                       group_color = color_list_Shipwreck$ProvGroup,
                       group_label_cex = 0.6,
                       arrow_mim_dist = .5,
                       arrow_label_cex = 0.6,
                       arrow_fig = c(.6,.95,0,.35),
                       arrow_label_adj_override = arrows_label_adj,
                       subtitle = prot4_Shipwreck_2d$sub2D,
                       test_text = 
                        prot4_Shipwreck_tests$text(prot4_Shipwreck_tests),
                       test_fig = c(0, 0.5, 0.62, .99),
                       fitAnalysis_fig = c(0,.7,.05,.5),
                       output_type = "preview")
protocol 4 with shipwrecks

protocol 4 with shipwrecks

Biplot 3D

biplot2d3d::biplot_3d(prot4_Shipwreck_3d,
                       ordination_method = "PCoA",
                       point_type = "point",
                       groups = factor_list_Shipwreck$FabricGroup,
                       group_color = color_list_Shipwreck$FabricGroup,
                       group_representation = "stars",
                       star_centroid_radius = 0,
                       star_label_cex = .8,
                       arrow_min_dist = .5,
                       arrow_body_length = .025,
                       subtitle = prot4_Shipwreck_3d$sub3D,
                       test_text = 
                        prot4_Shipwreck_tests$text(prot4_Shipwreck_tests),
                       test_cex = 1.25,
                       test_fig = c(0, 0.5, 0.65, .99),
                       view_zoom = 0.9)

biplot2d3d::animation(directory = directories$prot4_Shipwreck,
                       file_name = "Prot4_Shipwreck_Biplot3D")
Prot4_Shipwreck_Biplot3D.gif

Prot4_Shipwreck_Biplot3D.gif

Back to index